home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / autocad / 3dfurn.arj / 3DFURN.LSP next >
Text File  |  1993-10-21  |  15KB  |  350 lines
  1. ;;;
  2. ;;;  3d furniture construction.                                        ;
  3. ;;;  Student - Mark Williamson  9-23-92                                ;
  4. ;;;  Instructor - Tim Urbaniak / Drafting dept.  76264,2273            ;
  5. ;;;  Creates basic 3d cabinets, tables, and two types of chairs        ;
  6. ;;;  based on user supplied input. Program allows for the creation     ;
  7. ;;;  of multiple objects.                                              ;
  8. ;;;                                                                    ;
  9. ;;;  Another Billings Vocational Technical Center lab project...       ;
  10. ;;;      Your tax dollars at work...support education in your area.    ;
  11. ;;;            Public Domain                                           ;
  12. ;;;
  13. ;;;This part of the program will draw a 3d chair without arms
  14. ;;;based on the user supplied input.
  15. (defun c:chair ()                    ;get input for variables
  16.   (textscr) 
  17.   (setq sw (getdist "\nWidth of the seat (on the X): "))
  18.   (setq sl (getdist "\nLength of the seat (on the Y): "))
  19.   (setq sh (getdist "\nThickness of the seat (on the Z): "))
  20.   (setq bl (getdist "\nThickness of the back (on the Y): "))
  21.   (setq bh (getdist "\nHeight of the back (on the Z): "))
  22.   (setq lw (getdist "\nWidth of the leg (on the X): "))
  23.   (setq ll (getdist "\nLength of the leg (on the Y): "))
  24.   (setq lh (getdist "\nHeight of the leg (on the Z): "))
  25.   (setq nc (getint "\nNumber of chairs to build ?: "))
  26.   (graphscr) 
  27.   (setvar "blipmode" 0)
  28.   (setvar "cmdecho" 0)               ;set points for base of first leg
  29.   (setq tp (getvar "thickness"))     ;set up for multiple chairs
  30.   (repeat nc 
  31.     (setq sp (getpoint "\nLower left point for construction: ")) ;create the-
  32.                                      ; chair legs
  33.     (setq l1 sp)
  34.     (repeat 2 
  35.       (setq l2 (polar l1 (dtr 0.0) ll))
  36.       (setq l3 (polar l2 (dtr 90) lw))
  37.       (setq l4 (polar l3 (dtr 180) ll))
  38.       (setvar "thickness" lh)
  39.       (command "line" l1 l2 l3 l4 "c") 
  40.       (setvar "thickness" tp)
  41.       (command "3dface" l1 l2 l3 l4 "") 
  42.       (setq l1 (polar l1 (dtr 0.0) (- sl ll)))
  43.     ) 
  44.     (setq l1 sp)
  45.     (setq l1 (polar l1 (dtr 90) (- sw lw)))
  46.     (repeat 2 
  47.       (setq l2 (polar l1 (dtr 0.0) ll))
  48.       (setq l3 (polar l2 (dtr 90) lw))
  49.       (setq l4 (polar l3 (dtr 180) ll))
  50.       (setvar "thickness" lh)
  51.       (command "line" l1 l2 l3 l4 "c") 
  52.       (setvar "thickness" tp)
  53.       (command "3dface" l1 l2 l3 l4 "") 
  54.       (setq l1 (polar l1 (dtr 0.0) (- sl ll)))
  55.     )                                ;set points for top of first leg
  56.     (setq l1 sp)
  57.     (setq l5 (list (car l1) (cadr l1) (+ (caddr l1) lh)))
  58.     (setq l6 (list (car l2) (cadr l2) (+ (caddr l2) lh)))
  59.     (setq l7 (list (car l3) (cadr l3) (+ (caddr l3) lh)))
  60.     (setq l8 (list (car l4) (cadr l4) (+ (caddr l4) lh))) ;set points for seat
  61.     (setq s1 l5)
  62.     (setq s2 (polar s1 (dtr 0.0) sl))
  63.     (setq s3 (polar s2 (dtr 90) sw))
  64.     (setq s4 (polar s3 (dtr 180) sl)) ;set points for top of seat
  65.     (setq s5 (list (car s1) (cadr s1) (+ (caddr s1) sh)))
  66.     (setq s6 (list (car s2) (cadr s2) (+ (caddr s2) sh)))
  67.     (setq s7 (list (car s3) (cadr s3) (+ (caddr s3) sh)))
  68.     (setq s8 (list (car s4) (cadr s4) (+ (caddr s4) sh))) ;set points for back
  69.     (setq b2 s6)
  70.     (setq b1 (polar b2 (dtr 180) bl))
  71.     (setq b4 (polar b1 (dtr 90) sw))
  72.     (setq b3 s7)                     ;set points for the top of the back
  73.     (setq b5 (list (car b1) (cadr b1) (+ (caddr b1) bh)))
  74.     (setq b6 (list (car b2) (cadr b2) (+ (caddr b2) bh)))
  75.     (setq b7 (list (car b3) (cadr b3) (+ (caddr b3) bh)))
  76.     (setq b8 (list (car b4) (cadr b4) (+ (caddr b4) bh))) ;create the chair bas-
  77.                                      ;e
  78.     (setvar "thickness" sh)
  79.     (command "line" s1 s2 s3 s4 "c") 
  80.     (setvar "thickness" tp)
  81.     (command "3dface" s1 s2 s3 s4 "") 
  82.     (command "3dface" s5 b1 b4 s8 "") ;create the chair back
  83.     (setvar "thickness" bh)
  84.     (command "line" b1 b2 b3 b4 "c") 
  85.     (setvar "thickness" tp)
  86.     (command "3dface" b5 b6 b7 b8 "")
  87.   )
  88. ) 
  89. ;;;
  90. ;;;This part of the program will draw a 3d table
  91. ;;;based on user specified input.
  92. (defun c:table ()                    ;get input for variables
  93.   (textscr) 
  94.   (setq tw (getdist "\nWidth of the table (on the X): "))
  95.   (setq tl (getdist "\nLength of the table (on the Y): "))
  96.   (setq th (getdist "\nThickness of the table (on the Z): "))
  97.   (setq lw (getdist "\nWidth of the leg (on the X): "))
  98.   (setq ll (getdist "\nLength of the leg (on the Y): "))
  99.   (setq lh (getdist "\nHeight of the leg (on the Z): "))
  100.   (setq nt (getint "\nNumber of tables to build ?: "))
  101.   (graphscr) 
  102.   (setvar "blipmode" 0)
  103.   (setvar "cmdecho" 0)
  104.   (setq tp (getvar "thickness"))     ;set up for multiple tables
  105.   (repeat nt                         ;set points for base of first leg
  106.     (setq sp (getpoint "\nLower left point for construction: ")) ;create the-
  107.                                      ; chair legs
  108.     (setq l1 sp)
  109.     (repeat 2 
  110.       (setq l2 (polar l1 (dtr 0.0) ll))
  111.       (setq l3 (polar l2 (dtr 90) lw))
  112.       (setq l4 (polar l3 (dtr 180) ll))
  113.       (setvar "thickness" lh)
  114.       (command "line" l1 l2 l3 l4 "c") 
  115.       (setvar "thickness" tp)
  116.       (command "3dface" l1 l2 l3 l4 "") 
  117.       (setq l1 (polar l1 (dtr 0.0) (- tl ll)))
  118.     ) 
  119.     (setq l1 sp)
  120.     (setq l1 (polar l1 (dtr 90) (- tw lw)))
  121.     (repeat 2 
  122.       (setq l2 (polar l1 (dtr 0.0) ll))
  123.       (setq l3 (polar l2 (dtr 90) lw))
  124.       (setq l4 (polar l3 (dtr 180) ll))
  125.       (setvar "thickness" lh)
  126.       (command "line" l1 l2 l3 l4 "c") 
  127.       (setvar "thickness" tp)
  128.       (command "3dface" l1 l2 l3 l4 "") 
  129.       (setq l1 (polar l1 (dtr 0.0) (- tl ll)))
  130.     )                                ;set points for top of first leg
  131.     (setq l1 sp)
  132.     (setq l5 (list (car l1) (cadr l1) (+ (caddr l1) lh)))
  133.     (setq l6 (list (car l2) (cadr l2) (+ (caddr l2) lh)))
  134.     (setq l7 (list (car l3) (cadr l3) (+ (caddr l3) lh)))
  135.     (setq l8 (list (car l4) (cadr l4) (+ (caddr l4) lh))) ;set points for table
  136.     (setq t1 l5)
  137.     (setq t2 (polar t1 (dtr 0.0) tl))
  138.     (setq t3 (polar t2 (dtr 90) tw))
  139.     (setq t4 (polar t3 (dtr 180) tl)) ;set points for top of table
  140.     (setq t5 (list (car t1) (cadr t1) (+ (caddr t1) th)))
  141.     (setq t6 (list (car t2) (cadr t2) (+ (caddr t2) th)))
  142.     (setq t7 (list (car t3) (cadr t3) (+ (caddr t3) th)))
  143.     (setq t8 (list (car t4) (cadr t4) (+ (caddr t4) th))) ;create the table top
  144.     (setvar "thickness" th)
  145.     (command "line" t1 t2 t3 t4 "c") 
  146.     (setvar "thickness" tp)
  147.     (command "3dface" t1 t2 t3 t4 "") 
  148.     (command "3dface" t5 t6 t7 t8 "")
  149.   )
  150. ) 
  151. ;;;
  152. ;;;This part of the program will draw 3d cabinets with one shelf
  153. ;;;inserted at the half way point.
  154. (defun c:3dcab ()                    ;get input for variables
  155.   (textscr) 
  156.   (setq w (getdist "\nWidth of cabinet (on the x): "))
  157.   (setq l (getdist "\nLength of the cabinet (on the y): "))
  158.   (setq h (getdist "\nHeight of the cabinet (on the z): "))
  159.   (setq t (getdist "\nThickness of the cabinets (exp 1/4, 1/8): "))
  160.   (setq nc (getint "\nNumber of cabinets to build ?: ")) ;set points for the-
  161.                                      ; base 
  162.   (graphscr) 
  163.   (setvar "blipmode" 0)
  164.   (setvar "cmdecho" 0)
  165.   (setq tp (getvar "thickness"))
  166.   (setq sh (- h t))                  ;set up for multiple cabinets
  167.   (repeat nc 
  168.     (setq sp (getpoint "\nLower left point for construction: "))
  169.     (setq b1 sp)
  170.     (setq b2 (polar b1 (dtr 0.0) w))
  171.     (setq b3 (polar b2 (dtr 90) l))
  172.     (setq b4 (polar b3 (dtr 180) w)) ;set points for the top 
  173.     (setq t1 (list (car b1) (cadr b1) (+ (caddr b1) h)))
  174.     (setq t2 (list (car b2) (cadr b2) (+ (caddr b2) h)))
  175.     (setq t3 (list (car b3) (cadr b3) (+ (caddr b3) h)))
  176.     (setq t4 (list (car b4) (cadr b4) (+ (caddr b4) h))) ;set points for-
  177.                                      ; thickness of cabinets
  178.     ;;left side walls
  179.     (setq l1 (polar b1 (dtr 0.0) t))
  180.     (setq l2 (polar t1 (dtr 0.0) t))
  181.     (setq l3 (polar t4 (dtr 0.0) t))
  182.     (setq l4 (polar b4 (dtr 0.0) t)) ;right side walls
  183.     (setq r1 (polar b2 (dtr 180) t))
  184.     (setq r2 (polar t2 (dtr 180) t))
  185.     (setq r3 (polar t3 (dtr 180) t))
  186.     (setq r4 (polar b3 (dtr 180) t)) ;inside of back
  187.     (setq bk1 (polar l4 (dtr 270) t))
  188.     (setq bk2 (polar r4 (dtr 270) t))
  189.     (setq bk3 (polar r3 (dtr 270) t))
  190.     (setq bk4 (polar l3 (dtr 270) t)) ;inside bottom
  191.     (setq bt1 (list (car l1) (cadr l1) (+ (caddr l1) t)))
  192.     (setq bt2 (list (car r1) (cadr r1) (+ (caddr r1) t)))
  193.     (setq bt3 (list (car bk2) (cadr bk2) (+ (caddr bk2) t)))
  194.     (setq bt4 (list (car bk1) (cadr bk1) (+ (caddr bk1) t))) ;inside top
  195.     (setq tb1 (list (car l2) (cadr l2) (- (caddr l2) t)))
  196.     (setq tb2 (list (car r2) (cadr r2) (- (caddr r2) t)))
  197.     (setq tb3 (list (car bk3) (cadr bk3) (- (caddr bk3) t)))
  198.     (setq tb4 (list (car bk4) (cadr bk4) (- (caddr bk4) t))) ;set points for the-
  199.                                      ; bottom of the shelf
  200.     (setq th (/ t 2))
  201.     (setq sd (- (/ (- (caddr t1) (caddr b1)) 2) th))
  202.     (setq s1 (list (car l1) (cadr l1) sd))
  203.     (setq s2 (list (car r1) (cadr r1) sd))
  204.     (setq s3 (list (car bk2) (cadr bk2) sd))
  205.     (setq s4 (list (car bk1) (cadr bk1) sd)) ;top of the shelf
  206.     (setq s5 (list (car s1) (cadr s1) (+ (caddr s1) t)))
  207.     (setq s6 (list (car s2) (cadr s2) (+ (caddr s2) t)))
  208.     (setq s7 (list (car s3) (cadr s3) (+ (caddr s3) t)))
  209.     (setq s8 (list (car s4) (cadr s4) (+ (caddr s4) t))) ;begin entity creation
  210.     (setvar "thickness" h)
  211.     (command "line" b1 b4 b3 b2 "") 
  212.     (setvar "thickness" sh)
  213.     (command "line" l1 bk1 bk2 r1 "") 
  214.     (setvar "thickness" tp)
  215.     (command "3dface" b1 b2 b3 b4 "") 
  216.     (command "3dface" bt1 bt2 bt3 bt4 "") 
  217.     (command "3dface" tb1 tb2 tb3 tb4 "") 
  218.     (command "3dface" s1 s2 s3 s4 "") 
  219.     (command "3dface" s5 s6 s7 s8 "") 
  220.     (command "3dface" s1 s2 s6 s5 "") 
  221.     (command "3dface" t1 t2 t3 t4 "") 
  222.     (command "3dface" b1 t1 l2 l1 "") 
  223.     (command "3dface" b2 r1 r2 t2 "") 
  224.     (command "3dface" l1 r1 bt2 bt1 "") 
  225.     (command "3dface" tb1 tb2 r2 l2 "") 
  226.     (command "zoom" "e")
  227.   )
  228. ) 
  229. ;;;
  230. ;;;This part of the program will build a 3d chair with arms. 
  231. (defun c:armchr ()                   ;get input for variables
  232.   (textscr) 
  233.   (setq sw (getdist "\nWidth of the seat (on the X): "))
  234.   (setq sl (getdist "\nLength of the seat (on the Y): "))
  235.   (setq sh (getdist "\nThickness of the seat (on the Z): "))
  236.   (setq bl (getdist "\nThickness of the back (on the Y): "))
  237.   (setq bh (getdist "\nHeight of the back (on the Z): "))
  238.   (setq lw (getdist "\nWidth of the leg (on the X): "))
  239.   (setq ll (getdist "\nLength of the leg (on the Y): "))
  240.   (setq lh (getdist "\nHeight of the leg (on the Z): "))
  241.   (setq nc (getint "\nNumber of chairs to build ?: "))
  242.   (setq ad (- sl bl))
  243.   (setq aw lw)
  244.   (setq al (/ ll 2))
  245.   (setq at al)
  246.   (setq hat (/ at 2))
  247.   (setq ah (- (/ bh 2) hat))
  248.   (graphscr) 
  249.   (setvar "blipmode" 0)
  250.   (setvar "cmdecho" 0)               ;set points for base of first leg
  251.   (setq tp (getvar "thickness"))     ;set up for multiple chairs
  252.   (repeat nc 
  253.     (setq sp (getpoint "\nLower left point for construction: ")) ;create the-
  254.                                      ; chair legs
  255.     (setq l1 sp)
  256.     (repeat 2 
  257.       (setq l2 (polar l1 (dtr 0.0) ll))
  258.       (setq l3 (polar l2 (dtr 90) lw))
  259.       (setq l4 (polar l3 (dtr 180) ll))
  260.       (setvar "thickness" lh)
  261.       (command "line" l1 l2 l3 l4 "c") 
  262.       (setvar "thickness" tp)
  263.       (command "3dface" l1 l2 l3 l4 "") 
  264.       (setq l1 (polar l1 (dtr 0.0) (- sl ll)))
  265.     ) 
  266.     (setq l1 sp)
  267.     (setq l1 (polar l1 (dtr 90) (- sw lw)))
  268.     (repeat 2 
  269.       (setq l2 (polar l1 (dtr 0.0) ll))
  270.       (setq l3 (polar l2 (dtr 90) lw))
  271.       (setq l4 (polar l3 (dtr 180) ll))
  272.       (setvar "thickness" lh)
  273.       (command "line" l1 l2 l3 l4 "c") 
  274.       (setvar "thickness" tp)
  275.       (command "3dface" l1 l2 l3 l4 "") 
  276.       (setq l1 (polar l1 (dtr 0.0) (- sl ll)))
  277.     )                                ;set points for top of first leg
  278.     (setq l1 sp)
  279.     (setq l5 (list (car l1) (cadr l1) (+ (caddr l1) lh)))
  280.     (setq l6 (list (car l2) (cadr l2) (+ (caddr l2) lh)))
  281.     (setq l7 (list (car l3) (cadr l3) (+ (caddr l3) lh)))
  282.     (setq l8 (list (car l4) (cadr l4) (+ (caddr l4) lh))) ;set points for seat
  283.     (setq s1 l5)
  284.     (setq s2 (polar s1 (dtr 0.0) sl))
  285.     (setq s3 (polar s2 (dtr 90) sw))
  286.     (setq s4 (polar s3 (dtr 180) sl)) ;set points for top of seat
  287.     (setq s5 (list (car s1) (cadr s1) (+ (caddr s1) sh)))
  288.     (setq s6 (list (car s2) (cadr s2) (+ (caddr s2) sh)))
  289.     (setq s7 (list (car s3) (cadr s3) (+ (caddr s3) sh)))
  290.     (setq s8 (list (car s4) (cadr s4) (+ (caddr s4) sh))) ;set points for arm-
  291.                                      ; base
  292.     (setq a1 s5)
  293.     (repeat 2 
  294.       (setq a2 (polar a1 (dtr 0.0) al))
  295.       (setq a3 (polar a2 (dtr 90) aw))
  296.       (setq a4 (polar a3 (dtr 180) al)) ;set points for the armrests
  297.       (setq a5 (list (car a1) (cadr a1) (+ (caddr a1) ah)))
  298.       (setq a6 (polar a5 (dtr 0.0) (- sl bl)))
  299.       (setq a7 (polar a6 (dtr 90) aw))
  300.       (setq a8 (list (car a4) (cadr a4) (+ (caddr a4) ah)))
  301.       (setq a9 (list (car a5) (cadr a5) (+ (caddr a5) at)))
  302.       (setq a10 (list (car a6) (cadr a6) (+ (caddr a6) at)))
  303.       (setq a11 (list (car a7) (cadr a7) (+ (caddr a7) at)))
  304.       (setq a12 (list (car a8) (cadr a8) (+ (caddr a8) at)))
  305.       (setq a13 (polar a5 (dtr 0.0) al))
  306.       (setq a14 (polar a8 (dtr 0.0) al)) ;create the arms
  307.       (setvar "thickness" ah)
  308.       (command "line" a1 a2 a3 a4 "c") 
  309.       (setvar "thickness" at)
  310.       (command "line" a6 a5 a8 a7 "") 
  311.       (setvar "thickness" tp)
  312.       (command "3dface" a9 a10 a11 a12 "") 
  313.       (command "3dface" a13 a6 a7 a14 "") 
  314.       (setq a1 (polar s5 (dtr 90) (- sw aw)))
  315.     )                                ;set points for back
  316.     (setq b2 s6)
  317.     (setq b1 (polar b2 (dtr 180) bl))
  318.     (setq b4 (polar b1 (dtr 90) sw))
  319.     (setq b3 s7)                     ;set points for the top of the back
  320.     (setq b5 (list (car b1) (cadr b1) (+ (caddr b1) bh)))
  321.     (setq b6 (list (car b2) (cadr b2) (+ (caddr b2) bh)))
  322.     (setq b7 (list (car b3) (cadr b3) (+ (caddr b3) bh)))
  323.     (setq b8 (list (car b4) (cadr b4) (+ (caddr b4) bh))) ;create the chair bas-
  324.                                      ;e
  325.     (setvar "thickness" sh)
  326.     (command "line" s1 s2 s3 s4 "c") 
  327.     (setvar "thickness" tp)
  328.     (command "3dface" s1 s2 s3 s4 "") 
  329.     (command "3dface" s5 b1 b4 s8 "") ;create the chair back
  330.     (setvar "thickness" bh)
  331.     (command "line" b1 b2 b3 b4 "c") 
  332.     (setvar "thickness" tp)
  333.     (command "3dface" b5 b6 b7 b8 "")
  334.   )
  335. ) 
  336. ;;;
  337. ;;;end of program - start of dtr/rtd conversions
  338. (defun dtr (a) 
  339.   (* pi (/ a 180.0))
  340. ) 
  341. (defun rtd (a) 
  342.   (/ (* a 180.0) pi)
  343. ) 
  344. ;;;  
  345. (princ "\nThis program contains the commands: ") 
  346. (princ "\nTable, 3dcab, Chair, and Armchr.") 
  347. (princ) 
  348. ;;;
  349.  
  350.